Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/wildcat/wc2pc091.zip/WC2PCB.PAS

Pascal/Delphi Source File | 1996-04-13 | 5KB | 187 lines

{$M 8192,0,0}
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}

PROGRAM Convert_Wildcat_file_lists_to_PCBoard_format;
USES DOS;
VAR
  SavedExitProc: POINTER;  { CustomExit proc inserted into normal exit. }
  inFile, outFile : TEXT;

PROCEDURE NewLine; FORWARD;
PROCEDURE WriteStr (CONST s: STRING); FORWARD;
FUNCTION WordToHex (W: WORD): STRING; FORWARD;

PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
CONST
  NL = #13#10;
VAR
  message: STRING [79];
BEGIN
  ExitProc := SavedExitProc;
  IF (ExitCode > 0) THEN BEGIN
    NewLine;
    WriteStr ('wc2PCB v0.91ß - Free DOS utility: Convert Wildcat file lists to PCBoard format.');
    WriteStr ('April 13, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.' + NL);
    WriteStr ('Usage    :  wc2PCB  <inFile>  <outFile>'+ NL);
    WriteStr ('Example  :  wc2PCB  allfiles.lst  allfiles.pcb');
  END;
  IF ErrorAddr <> NIL THEN
  BEGIN
    WriteStr ('An unanticipated error occurred, please contact DDA with the following data:');
    WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
    WriteLn ('Code    = ', ExitCode);
    ErrorAddr := NIL;
  END
  ELSE
    IF (ExitCode IN [1..254]) THEN BEGIN
      CASE ExitCode OF
        7 : message := 'File handling error.  Make sure you specified "inFile" and "outFile" properly.';
        ELSE  message := 'Unknown error.';
      END;
      WriteLn ('Error encountered (#', ExitCode, '):'); WriteStr (message);
    END;
END;

PROCEDURE CheckIO; { Check IOResult, exit on error. }
BEGIN
  IF IOResult <> 0 THEN Halt (7);
END;

PROCEDURE NewLine;
BEGIN
  WriteLn;
END;

PROCEDURE WriteStr (CONST s: STRING);
BEGIN
  WriteLn (s);
END;

CONST
  HexDigits : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';

FUNCTION ByteToHex (B: BYTE): STRING; {Convert a BYTE var to Hex string}
BEGIN
  ByteToHex := Concat (HexDigits [B SHR 4], HexDigits [B AND $F]);
END;

FUNCTION WordToHex (W: WORD): STRING; {Convert a WORD var to Hex string}
BEGIN
  WordToHex := ByteToHex (Hi (W)) + ByteToHex (Lo (W));
END;

PROCEDURE OpenFiles;
VAR
  vErr: INTEGER;
BEGIN
  IF ParamCount <> 2 THEN Halt (255);

  Assign (inFile, ParamStr (1));
  Reset (inFile); CheckIO;

  Assign (outFile, ParamStr (2));
  Rewrite (outFile); CheckIO;

  Write ('Converting ' + ParamStr (1) + ' to ' + ParamStr (2));
END;

FUNCTION RTrim (InStr: STRING): STRING;
BEGIN
  WHILE (Length (InStr) > 0) AND (InStr [Length (InStr)] IN [#0, #9, #32]) DO
    Dec (InStr [0]);
  RTrim := InStr;
END;

FUNCTION LTrim (InStr: STRING): STRING;
BEGIN
  WHILE (Length (InStr) > 0) AND (InStr [1] IN [#0, #9, #32]) DO
    Delete (InStr, 1, 1);
  LTrim := InStr;
END;

FUNCTION Trim (InStr: STRING): STRING;
BEGIN
  Trim := RTrim (LTrim (InStr));
END;

FUNCTION IsFirstLine (aLine: STRING): BOOLEAN;
VAR
  First: BOOLEAN;
  fSizeStr: STRING;
  fSize, vErr: INTEGER;

BEGIN
  First := FALSE;

  IF (Length (aLine) >= 34) AND
     (NOT (aLine [1] IN [' ', '*', '.', '?'])) AND
     (Copy (aLine, 22, 3) = '   ') AND
     (Copy (aLine, 33, 2) = ' |') AND
     (aLine [27] = '/') AND (aLine [30] = '/')
  THEN BEGIN
    fSizeStr := Trim (Copy (aLine, 19, 3));
    Val (fSizeStr, fSize, vErr);
    IF (vErr = 0) AND (fSize >= 0) AND (fSize <= 999)
      THEN First := TRUE;
  END;
  IsFirstLine := First;
END;

VAR
  CurrLine: STRING;
  Written,
  EndOfDesc: BOOLEAN;

BEGIN
  SavedExitProc := ExitProc;
  ExitProc := @CustomExit;  { Insert custom exit procedure. }

  OpenFiles;
  WHILE NOT EoF (inFile) DO
  BEGIN
    ReadLn (inFile, CurrLine);
    CurrLine := RTrim (CurrLine);
    Written := FALSE;
    IF IsFirstLine (CurrLine) THEN
    BEGIN
      CurrLine := Copy (CurrLine, 1, 12) + #32#32 +  { File name }
                  Copy (CurrLine, 13, 1) +           { File size }
                  Copy (CurrLine, 15, 3) +
                  Copy (CurrLine, 19, 3) + #32#32 +
                  Copy (CurrLine, 25, 2) + #45 +     { File date }
                  Copy (CurrLine, 28, 2) + #45 +
                  Copy (CurrLine, 31, 2) + #32#32 +
                  Copy (CurrLine, 36, Length (CurrLine) - 35); { File desc }

      WriteLn (outFile, RTrim (CurrLine));

      EndOfDesc := FALSE;
      WHILE (NOT EndOfDesc) AND (NOT EoF (inFile)) DO
      BEGIN
        ReadLn (inFile, CurrLine);
        CurrLine := RTrim (CurrLine);
        Written := FALSE;
        IF (Copy (CurrLine, 33, 2) <> ' |') THEN
          EndOfDesc := TRUE
        ELSE BEGIN
          CurrLine := Copy (CurrLine, 36, Length (CurrLine) - 35);
          IF (CurrLine <> '') THEN WriteLn (outFile, '': 33, CurrLine);
          Written := TRUE;
        END;
      END;
    END;
    IF (NOT Written) AND (CurrLine <> '') THEN
    BEGIN
      IF Copy (CurrLine, 1, 6) = '**** [' THEN WriteLn (outFile);
      WriteLn (outFile, CurrLine);
      IF Copy (CurrLine, 1, 6) = '**** [' THEN WriteLn (outFile);
    END;
  END;

  Close (InFile);
  Close (OutFile);
  WriteStr (', done!');
END.